home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / zebu v3.3.3 (LALR parser) / zebu-empty-st.lisp < prev    next >
Encoding:
Text File  |  1994-09-12  |  2.2 KB  |  53 lines  |  [TEXT/ttxt]
  1. ; -*- mode:     CL -*- ------------------------------------------------- ;
  2. ; File:         empty-st.l
  3. ; Description:  Conversion to CL of the original Scheme program by (W M Wells)
  4. ; Author:       Joachim H. Laubsch
  5. ; Created:      31-Oct-90
  6. ; Modified:     Tue Jan 26 09:20:23 1993 (Joachim H. Laubsch)
  7. ; Language:     CL
  8. ; Package:      ZEBU
  9. ; Status:       Experimental (Do Not Distribute) 
  10. ; RCS $Header: $
  11. ;
  12. ; (c) Copyright 1990, Hewlett-Packard Company
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; Revisions:
  15. ; RCS $Log: $
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. ;;;             Copyright (C) 1989, by William M. Wells III
  18. ;;;                         All Rights Reserved
  19. ;;;     Permission is granted for unrestricted non-commercial use.
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21. (in-package "ZEBU")
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23. ;;;
  24. ;;; Cruise the productions and figure out which ones derive the empty string.
  25.  
  26. (defun calculate-empty-string-derivers ()
  27.   (labels ((string-vanishes (gslist)
  28.          (cond ((null gslist) t)
  29.            ((not (g-symbol-derives-empty-string (car gslist))) nil)
  30.            (T (string-vanishes (cdr gslist)))))
  31.        (process-symbol-which-derives-empty-string (gs)
  32.          (unless (g-symbol-derives-empty-string gs)
  33.            (let (*print-circle*)
  34.          (format t "~S derives the empty string~%" gs))
  35.            (setf (g-symbol-derives-empty-string gs) t)
  36.            (dolist (prod (g-symbol-rhs-productions gs))
  37.          (if (string-vanishes (rhs prod))
  38.              (process-symbol-which-derives-empty-string (lhs prod)))))))
  39.     (dolist (prod *productions*)
  40.       (unless (rhs prod)
  41.     (process-symbol-which-derives-empty-string (lhs prod))))))
  42.  
  43. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44. ;;; test:
  45. #||
  46. (load-grammar (merge-pathnames "ex3.zb" *ZEBU-test-directory*))
  47. (calculate-empty-string-derivers)
  48. ||#
  49.  
  50. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  51. ;;                              End of empty-st.l
  52. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53.